home *** CD-ROM | disk | FTP | other *** search
/ Professional Soft Collection 1.02 / Professional Soft Collection 1.02.iso / communic / qmodempr / script.pak / HOSTDOS.SCR < prev    next >
Encoding:
Text File  |  1994-03-01  |  7.3 KB  |  282 lines
  1. ' DOS Shell
  2.  
  3. function MakePrompt(prompt as string) as string
  4.   dim res as string, s as string
  5.   do while prompt <> ""
  6.     if left(prompt, 1) = "$" then
  7.       prompt = right(prompt, len(prompt)-1)
  8.       select case OemUpper(left(prompt, 1))
  9.         case "$"
  10.           s = "$"
  11.         case "B"
  12.           s = "|"
  13.         case "D"
  14.           s = date
  15.         case "E"
  16.           s = ESC
  17.         case "G"
  18.           s = ">"
  19.         case "H"
  20.           s = BS+" "+BS
  21.         case "L"
  22.           s = "<"
  23.         case "N"
  24.           s = curdrive
  25.         case "P"
  26.           s = curdir
  27.         case "Q"
  28.           s = "="
  29.         case "T"
  30.           s = time
  31.         case "V"
  32.           s = "version"
  33.         case "_"
  34.           s = CR+LF
  35.         case else
  36.           s = "$" + left(prompt, 1)
  37.       end select
  38.       res = res + s
  39.     else
  40.       res = res + left(prompt, 1)
  41.     end if
  42.     prompt = right(prompt, len(prompt)-1)
  43.   loop
  44.   MakePrompt = res
  45. end function
  46.  
  47. sub DosShellDir(fn as string)
  48.   dim sr as SearchRec
  49.   dim result as integer
  50.   dim i as integer, count as integer
  51.   dim dir as string
  52.   if fn = "" then
  53.     fn = "*.*"
  54.   end if
  55.   dir = JustPathname(fn)
  56.   if len(dir) = 0 then
  57.     dir = AddBackSlash(CurDir)
  58.   else
  59.     dir = AddBackSlash(dir)
  60.   end if
  61.   send #Port,
  62.   send #Port, " Volume in drive "; CurDrive;
  63.   result = FindFirst("\*.*", 8, sr)
  64.   if result = 0 then
  65.     send #Port, " is ", sr.name
  66.   else
  67.     send #Port, " has no label"
  68.   end if
  69.   send #Port, " Directory of "; dir
  70.   send #Port,
  71.   count = 0
  72.   result = FindFirst(fn, 16, sr)
  73.   if result = 0 then
  74.     do
  75.       i = instr(sr.name, ".")
  76.       if i > 0 then
  77.         send #Port, left(sr.name, i-1); tab(10); right(sr.name, len(sr.name)-i); tab(14);
  78.       else
  79.         send #Port, sr.name; tab(14);
  80.       end if
  81.       if (sr.attribute and 16) <> 0 then
  82.         send #Port, " <DIR>     ";
  83.       else
  84.         send #Port, space(11-len(str(sr.size))); sr.size;
  85.       end if
  86.       send #Port, DateToDateString(" mm-dd-yy", DMYtoDate(sr.date and 0x1f, (sr.date\32) and 0xf, 1980+(sr.date\512)));
  87.       send #Port, TimeToTimeString(" HH:mmt", HMStoTime(sr.time\2048, (sr.time\32) and 0x3f, (sr.time and 0x1f) * 2));
  88.       send #Port,
  89.       count = count + 1
  90.       if count >= 24 then
  91.         if OemUpper(GetLine("-Pause- [C]ontinue, [S]top? ", 1)) = "S" then
  92.           exit do
  93.         end if
  94.         count = 0
  95.       end if
  96.       result = FindNext(sr)
  97.     loop while result = 0
  98.   else
  99.     send #Port, "File not found"
  100.   end if
  101. end sub
  102.  
  103. type buffertype
  104.   data(1024) as byte
  105. end type
  106.  
  107. sub DosShellCopy(src as string, dest as string)
  108.   dim inf as integer, outf as integer
  109.   inf = freefile
  110.   open src for random as #inf len = len(buffertype)
  111.   outf = freefile
  112.   open dest for append as #outf len = len(buffertype)
  113.   close outf
  114.   open dest for random as #outf len = len(buffertype)
  115.   dim buf as buffertype
  116.   dim recs as long
  117.   recs = 0
  118.   do while not eof(inf)
  119.     get #inf, , buf
  120.     put #outf, , buf
  121.     recs = recs + 1
  122.   loop
  123.   close inf
  124.   close outf
  125.   open src for random as #inf len = 1
  126.   open dest for random as #outf len = 1
  127.   seek #inf, (recs - 1) * len(buffertype) + 1
  128.   seek #outf, (recs - 1) * len(buffertype) + 1
  129.   do while not eof(inf)
  130.     get #inf, , buf
  131.     put #outf, , buf
  132.   loop
  133.   close inf
  134.   close outf
  135. end sub
  136.  
  137. sub DosShell
  138.   dim prompt as string, origdir as string
  139.   if User.Level = 0 or Setup.dospass = "" then
  140.     send #Port, "Sorry, drop to DOS not available."
  141.     send #Port,
  142.     exit sub
  143.   end if
  144.   if OemUpper(GetLine("Enter DOS password: ", 0, "", "*")) <> OemUpper(Setup.dospass) then
  145.     send #Port,
  146.     send #Port, "Wrong password entered."
  147.     send #Port,
  148.     exit sub
  149.   end if
  150.   prompt = environ("PROMPT")
  151.   if prompt = "" then
  152.     prompt = "$P$G"
  153.   end if
  154.   origdir = curdir
  155. goagain:
  156.   do
  157.     send #Port,
  158.     dim cmdline as string, cmd as string, arg(10) as string, i as integer
  159.     cmdline = ltrim(rtrim(GetLine(MakePrompt((prompt)))))
  160.     cmd = OemUpper(NextField(cmdline, " "))
  161.     for i = 1 to 10
  162.       arg(i) = NextField(cmdline, " ")
  163.     next i
  164.     select case cmd
  165.       case "CD", "CHDIR"
  166.         if arg(1) = "" then
  167.           send #Port, curdir
  168.         else
  169.           chdir arg(1)
  170.         end if
  171.       case "CLS"
  172.         send #Port, chr(27)+"[2H"+chr(27)+"[2J";
  173.         cls
  174.       case "COPY"
  175.         if arg(1) <> "" and arg(2) <> "" then
  176.           if exists(arg(1)) then
  177.             if exists(arg(2)) then
  178.               send #Port, "Destination file "; arg(2); " already exists"
  179.             else
  180.               DosShellCopy arg(1), arg(2)
  181.             end if
  182.           else
  183.             send #Port, "Source file "; arg(1); " does not exist"
  184.           end if
  185.         end if
  186.       case "DATE"
  187.         send #Port, Date
  188.       case "DEL", "ERASE"
  189.         if arg(1) <> "" then
  190.           dim sr as SearchRec
  191.           dim result as integer
  192.           result = findfirst(arg(1), 0, sr)
  193.           do while result = 0
  194.             dim s as string
  195.             s = JustPathname(arg(1))
  196.             if len(s) > 0 then
  197.               del AddBackSlash(s)+sr.name
  198.             else
  199.               del sr.name
  200.             end if
  201.             result = findnext(sr)
  202.           loop
  203.           del arg(1) '!! wildcards
  204.         else
  205.           send #Port, "Filename expected"
  206.         end if
  207.       case "DIR"
  208.         DosShellDir(arg(1))
  209.       case "EXIT"
  210.         exit do
  211.       case "HELP"
  212.         if not DisplayFile("hostdos.hlp") then
  213.           send #Port, "No help available"
  214.         end if
  215.       case "MD", "MKDIR"
  216.         if arg(1) <> "" then
  217.           mkdir arg(1)
  218.         else
  219.           send #Port, "Directory expected"
  220.         end if
  221.       case "MOVE"
  222.         if arg(1) <> "" and arg(2) <> "" then
  223.           if exists(arg(1)) then
  224.             if exists(arg(2)) then
  225.               send #Port, "Destination file "; arg(2); " already exists"
  226.             else
  227.               name arg(1) as arg(2)
  228.             end if
  229.           else
  230.             send #Port, "Source file "; arg(1); " does not exist"
  231.           end if
  232.         end if
  233.       case "PROMPT"
  234.         if arg(1) = "" then
  235.           send #Port, prompt
  236.         else
  237.           prompt = arg(1)
  238.         end if
  239.       case "RD", "RMDIR"
  240.         if arg(1) <> "" then
  241.           rmdir arg(1)
  242.         else
  243.           send #Port, "Directory expected"
  244.         end if
  245.       case "REN", "RENAME"
  246.         if arg(1) <> "" and arg(2) <> "" then
  247.           name arg(1) as arg(2)
  248.         else
  249.           send #Port, "Two filenames expected"
  250.         end if
  251.       case "TIME"
  252.         send #Port, Time
  253.       case "TYPE"
  254.         if arg(1) <> "" then
  255.           DisplayFile arg(1)
  256.         else
  257.           send #Port, "Filename expected"
  258.         end if
  259.       case "VER"
  260.         send #Port, "QmodemPro for Windows "; version; " DOS shell"
  261.       case is <> ""
  262.         if len(cmd) = 2 and right(cmd, 1) = ":" then
  263.           chdrive left(cmd, 1)
  264.         else
  265.           send #Port, "Bad command or file name"
  266.         end if
  267.     end select
  268.   loop until CallerHungUp
  269.   chdrive origdir
  270.   chdir origdir
  271.  
  272. catch err_fileopen
  273.   send #Port, "Error opening file"
  274.   goto goagain
  275. catch err_path
  276.   send #Port, "Error in directory"
  277.   goto goagain
  278. catch err_filerename
  279.   send #Port, "Error renaming file"
  280.   goto goagain
  281. end sub
  282.